DAG analysis
danhicks
2022-07-15
# TODO:
# -[] clean code
# -[] predicted value plots for E and F
# -[] webshot::install_phantomjs() in make install
library(tidyverse)## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──## ✓ ggplot2 3.3.5 ✓ purrr 0.3.4
## ✓ tibble 3.1.6 ✓ dplyr 1.0.8
## ✓ tidyr 1.2.0 ✓ stringr 1.4.0
## ✓ readr 2.1.2 ✓ forcats 0.5.1## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()theme_set(theme_minimal())
library(broom)
library(patchwork)
library(ggbeeswarm)
library(dagitty)
library(ggdag)##
## Attaching package: 'ggdag'## The following object is masked from 'package:stats':
##
## filter## <https://cran.r-project.org/web/packages/ggdag/vignettes/intro-to-ggdag.html>
library(gt)
library(gtsummary)
## Need Hmisc for bootstrap CIs in some plots, but don't want to load it
find.package('Hmisc')## [1] "/Users/danhicks/Library/Caches/org.R-project.R/R/renv/library/transparency-b4b6f02c/R-4.1/x86_64-apple-darwin17.0/Hmisc"library(here)## here() starts at /Users/danhicks/Google Drive/Writing/transparencysource(here('R', 'reg_tbl.R'))
source(here('R', 'plot_adjustments.R'))
source(here('R', 'reg_plots.R'))
library(car)## Loading required package: carData##
## Attaching package: 'car'## The following object is masked from 'package:dplyr':
##
## recode## The following object is masked from 'package:purrr':
##
## someoptions(contrasts = c('contr.Treatment', 'contr.poly'))
options(decorate.contr.Treatment = '')
out_dir = here('out')
if (!dir.exists(out_dir)) {
dir.create(out_dir)
}
data_dir = here('data')
## Load data ----
## Elliott et al. data
emad_df = read_rds(here(data_dir, 'emad.Rds'))
## Our data
dataf = read_rds(here(data_dir, 'data.Rds'))
## Descriptive summary of our data ----
## - age
## - gender
## - race/ethnicity
## - <https://www.census.gov/library/visualizations/interactive/race-and-ethnicity-in-the-united-state-2010-and-2020-census.html>
## - overrep White (72% vs. 62%)
## - underrep Hispanic (3% vs. 19%)
## - Black and A/PI represented accurately at 13% and 6%
## - religious affiliation
## - religious services
## - political ideology
## - political affiliation
## - education
## - <https://www.statista.com/statistics/184260/educational-attainment-in-the-us/>
## - underrep non-HS grads (1% vs. 9%)
## - overrep college grads (57% vs. 38%)
## - participant values
re_labels = c('American Indian or Alaskan Native',
'Asian or Pacific Islander',
'Black',
'Hispanic',
'White',
'Other',
'Prefer not to answer')
relig_labels = c('Buddhist',
'Catholic',
'Hindu',
'Jewish',
'Muslim',
'Protestant',
'No religion',
'Other', 'Prefer not to answer')
relig_serv_labels = c('Never',
'A few times per year',
'Once every month or two',
'2-3 times per month',
'Once per week',
'More than once per week',
'Daily')
poli_id_labels = c('Strongly liberal',
'Moderately liberal',
'Mildly liberal',
'Centrist',
'Mildly conservative',
'Moderately conservative',
'Strongly conservative',
'Other',
'Prefer not to answer')
poli_aff_labels = c('Democratic party',
'Republican party',
'Independent/no party',
'Other',
'Prefer not to answer')
edu_labels = c('Less than high school',
'High school, or some college',
'Bachelor’s degree or higher')
fix_multifac = function(vec, labs, ordered = FALSE) {
chr = vec |>
as.character() |>
str_split(',') |>
map(~ labs[as.integer(.x)]) |>
map_chr(str_c, collapse = '/')
if (!ordered) {
return(chr)
} else {
fct_relevel(chr, labs)
}
}
demo_gt = dataf |>
select(pid, age, gender, race_ethnicity,
religious_affil, religious_serv,
political_ideology, political_affiliation,
education, part_values, disclosure) |>
mutate(gender = fct_drop(gender),
race_ethnicity = fix_multifac(race_ethnicity, re_labels),
religious_affil = fix_multifac(religious_affil, relig_labels),
religious_serv = fix_multifac(religious_serv, relig_serv_labels,
ordered = TRUE),
political_ideology = fix_multifac(political_ideology, poli_id_labels,
ordered = TRUE),
political_affiliation = fix_multifac(political_affiliation,
poli_aff_labels),
education = fix_multifac(education, edu_labels, ordered = TRUE)) |>
select(-pid) |>
tbl_summary(label = list(race_ethnicity ~ 'race/ethnicity',
religious_affil ~ 'religious affiliation',
religious_serv ~ 'religious service attendance',
political_ideology ~ 'political ideology',
political_affiliation ~ 'political affiliation',
part_values ~ 'participant values'),
sort = list(race_ethnicity ~ 'frequency',
religious_affil ~ 'frequency')) |>
bold_labels()## Warning: Unknown levels in `f`: Other, Prefer not to answerdemo_gt |>
as_flex_table() |>
flextable::save_as_docx(path = here(out_dir, '03_demo_table.docx'),
pr_section = officer::prop_section(page_size = officer::page_size(orient = "landscape")))
## Trust, overall ----
ggplot() +
geom_violin(aes(x = 'EMAD', pa_mean),
draw_quantiles = .5,
data = emad_df) +
geom_beeswarm(aes(x = 'EMAD', pa_mean),
data = emad_df) +
geom_violin(aes(x = 'HL', meti_mean),
draw_quantiles = .5,
data = dataf) +
geom_beeswarm(aes(x = 'HL', meti_mean),
data = dataf) +
ylab('mean trust')
Across our dataset, standard deviation of mean trust. Use one-third of this as meaningful.
sd(dataf$meti_mean)## [1] 1.288985meaningful = sd(dataf$meti_mean)/3
meaningful## [1] 0.4296617## A. Modest correlation between values and ideology ----A. Modest correlation between values and ideology
(i) Political liberals are more likely to prioritize public health over economic growth, compared to political conservatives; but (ii) a majority of political conservatives prioritize public health.
NB 1. No DAG here because this isn’t a causal claim. 2. Direction of ideology coding is reversed between the two studies.
Compared to Elliott et al., our strong conservatives placed lower value on public health, and overall conservatives are about 50-50.
emad_df |>
count(ideology, tradeoff) |>
group_by(ideology) |>
mutate(share = n / sum(n)) |>
ungroup() |>
ggplot(aes(ideology, n, fill = as.factor(tradeoff))) +
geom_col() +
scale_fill_viridis_d()
last_plot() + aes(y = share)
part_values_plot = dataf |>
filter(!is.na(pref)) |>
count(political_ideology, part_values) |>
group_by(political_ideology) |>
mutate(share = n / sum(n)) |>
ungroup() |>
ggplot(aes(political_ideology, n, fill = part_values)) +
geom_col(color = 'black') +
scale_x_continuous(labels = NULL,
name = '← liberal conservative →\npolitical ideology') +
scale_fill_viridis_d(option = 'E', name = 'participant\nvalues')
part_values_plot## Warning: Removed 2 rows containing missing values (position_stack).
part_values_share = part_values_plot + aes(y = share) +
scale_y_continuous(labels = scales::percent_format())
part_values_share## Warning: Removed 2 rows containing missing values (position_stack).
part_values_plot + part_values_share +
plot_layout(guides = 'collect') +
plot_annotation(tag_levels = 'A')## Warning: Removed 2 rows containing missing values (position_stack).
## Removed 2 rows containing missing values (position_stack).
ggsave(here(out_dir, '03_part_values.png'),
height = 4, width = 8, dpi = 200, scale = 1.5)## Warning: Removed 2 rows containing missing values (position_stack).
## Removed 2 rows containing missing values (position_stack).table(dataf$political_ideology, dataf$pref)##
## 1 2 3 4
## 1 5 1 18 133
## 2 9 13 47 135
## 3 5 14 44 66
## 4 16 19 31 39
## 5 13 18 22 27
## 6 22 27 18 25
## 7 19 9 3 6dataf |>
mutate(political_ideology = case_when(
political_ideology < 4 ~ 'liberal',
political_ideology == 4 ~ 'moderate',
political_ideology > 4 ~ 'conservative'
)) |>
count(political_ideology)## # A tibble: 4 × 2
## political_ideology n
## <chr> <int>
## 1 conservative 248
## 2 liberal 574
## 3 moderate 118
## 4 <NA> 48cor(emad_df$ideology, emad_df$tradeoff,
use = 'complete.obs',
method = 'spearman')## [1] 0.2717778cor(as.integer(dataf$political_ideology), as.integer(dataf$pref),
use = 'complete.obs',
method = 'spearman')## [1] -0.4712353glm(I(part_values == 'economic growth') ~ political_ideology,
family = 'binomial',
data = dataf) |>
summary()##
## Call:
## glm(formula = I(part_values == "economic growth") ~ political_ideology,
## family = "binomial", data = dataf)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.5838 -0.6027 -0.4484 -0.3306 2.4225
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -3.51269 0.24200 -14.52 <2e-16 ***
## political_ideology 0.63300 0.05455 11.61 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 879.25 on 803 degrees of freedom
## Residual deviance: 711.42 on 802 degrees of freedom
## (184 observations deleted due to missingness)
## AIC: 715.42
##
## Number of Fisher Scoring iterations: 5## DAG ----DAG
We use the following DAG throughout the rest of this analysis
dag = dagify(METI ~ shared_values + sci_values +
part_values + demographics,
shared_values ~ part_values + sci_values,
part_values ~ demographics,
outcome = 'METI') |>
tidy_dagitty(layout = 'kk')
ggplot(dag, aes(x = x, y = y,
xend = xend, yend = yend)) +
geom_label(aes(label = name)) +
geom_dag_edges() +
coord_cartesian(clip = 'off') +
theme_dag()
## B. Consumer risk sensitivity ----B. Consumer risk sensitivity
Scientists who find that a chemical harms human health are perceived as more trustworthy than scientists who find that a chemical does not cause harm.
ggplot(emad_df, aes(conclusion, pa_mean)) +
geom_violin(draw_quantiles = .5) +
geom_beeswarm()
ggplot(dataf, aes(conclusion, meti_mean)) +
geom_violin(draw_quantiles = .5) +
geom_beeswarm()
Because the conclusion is experimentally manipulated, we don’t need any adjustments.
dag |>
add_arrows('conclusion -> METI') |>
plot_adjustments(exposure = 'conclusion') +
scale_color_manual(values = 'black')
model_b_emad = lm(pa_mean ~ conclusion, data = emad_df)
summary(model_b_emad)##
## Call:
## lm(formula = pa_mean ~ conclusion, data = emad_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.6131 -0.8536 0.1012 1.1464 2.4321
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.61306 0.08953 62.693 < 2e-16 ***
## conclusion[does not cause harm] -1.04516 0.12415 -8.418 4.12e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.384 on 496 degrees of freedom
## Multiple R-squared: 0.125, Adjusted R-squared: 0.1233
## F-statistic: 70.87 on 1 and 496 DF, p-value: 4.121e-16model_b = lm(meti_mean ~ conclusion, data = dataf)
summary(model_b)##
## Call:
## lm(formula = meti_mean ~ conclusion, data = dataf)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.8315 -0.7601 0.0256 0.8730 2.5158
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.47437 0.05346 102.40 <2e-16 ***
## conclusion[does not cause harm] -0.99019 0.07576 -13.07 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.191 on 986 degrees of freedom
## Multiple R-squared: 0.1477, Adjusted R-squared: 0.1468
## F-statistic: 170.8 on 1 and 986 DF, p-value: < 2.2e-16plot_residuals(model_b)## `geom_smooth()` using formula 'y ~ x'
plot_estimate(list(emad = model_b_emad,
hl = model_b),
str_detect(term, 'conclusion'))
tbl_regression(model_b, intercept = TRUE) |>
add_glance_table(include = c(r.squared, nobs, statistic, p.value))| Characteristic | Beta | 95% CI1 | p-value |
|---|---|---|---|
| (Intercept) | 5.5 | 5.4, 5.6 | <0.001 |
| conclusion | |||
| conclusion[does not cause harm] | -1.0 | -1.1, -0.84 | <0.001 |
| R² | 0.148 | ||
| No. Obs. | 988 | ||
| Statistic | 171 | ||
| p-value | <0.001 | ||
| 1 CI = Confidence Interval | |||
list(emad = model_b_emad,
hl = model_b) |>
reg_tbl()| Characteristic | EMAD | HL replication | ||||
|---|---|---|---|---|---|---|
| Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | |
| (Intercept) | 5.6 | 5.4, 5.8 | <0.001 | 5.5 | 5.4, 5.6 | <0.001 |
| conclusion | ||||||
| conclusion[does not cause harm] | -1.0 | -1.3, -0.80 | <0.001 | -1.0 | -1.1, -0.84 | <0.001 |
| R² | 0.125 | 0.148 | ||||
| No. Obs. | 498 | 988 | ||||
| Adjusted R² | 0.123 | 0.147 | ||||
| Statistic | 70.9 | 171 | ||||
| p-value | <0.001 | <0.001 | ||||
| 1 CI = Confidence Interval | ||||||
## C. Transparency penalty ----C. Transparency penalty
Scientists who disclose values are perceived as less trustworthy than scientists who do not.
{
trans_plot_emad = ggplot(emad_df, aes(disclosure, pa_mean)) +
# geom_violin(draw_quantiles = .5) +
geom_beeswarm(alpha = .25, size = .3) +
stat_summary(fun.data = mean_cl_boot, color = 'red',
size = 1, fatten = 0) +
stat_summary(geom = 'line', group = 1L, color = 'red') +
labs(y = 'trust')
trans_plot_emad
trans_plot_us = ggplot(dataf, aes(disclosure, meti_mean)) +
geom_beeswarm(alpha = .25, size = .3) +
stat_summary(fun.data = mean_cl_boot, color = 'red',
size = 1, fatten = 0) +
stat_summary(geom = 'line', group = 1L, color = 'red') +
labs(y = 'trust')
trans_plot_us
trans_plot_emad +
ggtitle('EMAD') +
trans_plot_us +
ggtitle('HL replication')
ggsave(here(out_dir, '03_transparency.png'),
height = 3, width = 6, scale = 1,
bg = 'white')
}## No summary function supplied, defaulting to `mean_se()`
## No summary function supplied, defaulting to `mean_se()`Again, disclosure/transparency is experimentally controlled, so no adjustment is required.
dag |>
add_arrows('disclose -> METI') |>
plot_adjustments('disclose') +
scale_color_manual(values = 'black')
model_c_emad = lm(pa_mean ~ disclosure, data = emad_df)
summary(model_c_emad)##
## Call:
## lm(formula = pa_mean ~ disclosure, data = emad_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.3917 -0.9519 0.1798 1.2231 2.0802
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.3917 0.1164 46.316 < 2e-16 ***
## disclosure[TRUE] -0.4719 0.1409 -3.349 0.000871 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.463 on 496 degrees of freedom
## Multiple R-squared: 0.02212, Adjusted R-squared: 0.02015
## F-statistic: 11.22 on 1 and 496 DF, p-value: 0.0008714model_c = lm(meti_mean ~ disclosure, data = dataf)
summary(model_c)##
## Call:
## lm(formula = meti_mean ~ disclosure, data = dataf)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.9447 -0.9120 0.0880 0.9839 2.0553
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.05488 0.07115 71.045 <2e-16 ***
## disclosure[TRUE] -0.11018 0.08705 -1.266 0.206
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.289 on 986 degrees of freedom
## Multiple R-squared: 0.001622, Adjusted R-squared: 0.0006095
## F-statistic: 1.602 on 1 and 986 DF, p-value: 0.2059plot_residuals(model_c)## `geom_smooth()` using formula 'y ~ x'
# plot_estimate(model_c, 'disclosure')
plot_estimate(list(emad = model_c_emad,
hl = model_c),
str_detect(term, 'disclosure'))
list(emad = model_c_emad,
hl = model_c) |>
reg_tbl()| Characteristic | EMAD | HL replication | ||||
|---|---|---|---|---|---|---|
| Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | |
| (Intercept) | 5.4 | 5.2, 5.6 | <0.001 | 5.1 | 4.9, 5.2 | <0.001 |
| disclosure | ||||||
| disclosure[TRUE] | -0.47 | -0.75, -0.20 | <0.001 | -0.11 | -0.28, 0.06 | 0.2 |
| R² | 0.022 | 0.002 | ||||
| No. Obs. | 498 | 988 | ||||
| Adjusted R² | 0.020 | 0.001 | ||||
| Statistic | 11.2 | 1.60 | ||||
| p-value | <0.001 | 0.2 | ||||
| 1 CI = Confidence Interval | ||||||
## B + C combined table ----
model_bc_emad = lm(pa_mean ~ conclusion + disclosure, data = emad_df)
model_bc = lm(meti_mean ~ conclusion + disclosure, data = dataf)
bc_tbl = list(emad = model_bc_emad,
hl = model_bc) |>
reg_tbl()
bc_tbl| Characteristic | EMAD | HL replication | ||||
|---|---|---|---|---|---|---|
| Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | |
| (Intercept) | 6.0 | 5.7, 6.2 | <0.001 | 5.6 | 5.4, 5.7 | <0.001 |
| conclusion | ||||||
| conclusion[does not cause harm] | -1.1 | -1.3, -0.82 | <0.001 | -1.0 | -1.1, -0.84 | <0.001 |
| disclosure | ||||||
| disclosure[TRUE] | -0.52 | -0.78, -0.26 | <0.001 | -0.12 | -0.28, 0.04 | 0.14 |
| R² | 0.152 | 0.150 | ||||
| No. Obs. | 498 | 988 | ||||
| Adjusted R² | 0.148 | 0.148 | ||||
| Statistic | 44.3 | 86.6 | ||||
| p-value | <0.001 | <0.001 | ||||
| 1 CI = Confidence Interval | ||||||
write_reg_tbl(bc_tbl, here(out_dir, '03_bc_tbl'))
## D. Shared values ----D. Shared values
Given that the scientist discloses values, if the participant and the scientist share the same values, the scientist is perceived as more trustworthy than if the participant and scientist have discordant values.
emad_df |>
filter(disclosure, !is.na(part_values)) |>
ggplot(aes(shared_values, pa_mean)) +
geom_violin(draw_quantiles = .5) +
geom_beeswarm()
dataf |>
filter(disclosure, !is.na(part_values)) |>
ggplot(aes(shared_values, meti_mean)) +
geom_violin(draw_quantiles = .5) +
geom_beeswarm()
In our actual situation, we only need to adjust for
participant values and scientist values;
participant values is on every back-door path running
through demographics or VISS variables.
plot_adjustments(dag, 'shared_values') +
coord_cartesian(clip = 'off')
ggsave(here(out_dir, '03_shared_values_dag.png'),
height = 3, width = 6, dpi = 200, scale = 1.5)However, if participant values and
shared values had some common cause
problem_var, then participant values is a
collider between problem_var and demographics;
either we control for problem_var or we control all the
demographics (and possibly worry about the exact structure of the
demographics subgraph). Big problem if we didn’t observe
problem_var! Fortunately we know by construction of
shared values that there is no such common cause.
dag |>
add_arrows(c('problem_var -> shared_values',
'problem_var -> part_values')) |>
plot_adjustments('shared_values')
This doesn’t happen if we have a problem variable elsewhere, because
participant values is not a collider on any path that might
result.
dag |>
add_arrows(c('part_values <- problem_var -> demographics')) |>
plot_adjustments('shared_values')
So, all together, we just need to adjust for participant values and scientist values.
model_d_emad = emad_df |>
filter(disclosure) %>%
lm(pa_mean ~ shared_values + part_values + sci_values, data = .)
summary(model_d_emad)##
## Call:
## lm(formula = pa_mean ~ shared_values + part_values + sci_values,
## data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.0914 -0.9710 0.0515 1.0508 2.4678
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.6795 0.1663 28.138 <2e-16 ***
## shared_values[TRUE] 0.2915 0.1663 1.753 0.0805 .
## part_values[public health] -0.1473 0.1663 -0.886 0.3763
## sci_values[public health] 0.4119 0.1663 2.477 0.0138 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.466 on 335 degrees of freedom
## (1 observation deleted due to missingness)
## Multiple R-squared: 0.03948, Adjusted R-squared: 0.03088
## F-statistic: 4.59 on 3 and 335 DF, p-value: 0.003648model_d = dataf |>
filter(disclosure) %>%
lm(meti_mean ~ shared_values + part_values + sci_values, data = .)
summary(model_d)##
## Call:
## lm(formula = meti_mean ~ shared_values + part_values + sci_values,
## data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.8416 -0.8981 -0.0559 0.9590 2.4590
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.71968 0.13216 35.711 < 2e-16 ***
## shared_values[TRUE] 0.09958 0.13216 0.753 0.451
## part_values[public health] -0.17873 0.13216 -1.352 0.177
## sci_values[public health] 0.62967 0.13216 4.764 2.41e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.285 on 563 degrees of freedom
## (93 observations deleted due to missingness)
## Multiple R-squared: 0.0701, Adjusted R-squared: 0.06514
## F-statistic: 14.15 on 3 and 563 DF, p-value: 6.696e-09plot_residuals(model_d)## `geom_smooth()` using formula 'y ~ x'
# plot_estimate(model_d, 'shared_values')
plot_estimate(list(emad = model_d_emad,
hl = model_d),
str_detect(term, 'shared_values'))
But we can include demographics to check the accuracy of the graph. In the Elliott et al. data, this holds true: adding other demographics doesn’t change the estimated effect for shared values of 0.4.
model_d1 = dataf |>
filter(disclosure) %>%
lm(meti_mean ~ shared_values + part_values + sci_values +
age + gender + race_ethnicity + religious_affil + religious_serv +
political_ideology + education,
data = .)
broom::tidy(model_d1)## # A tibble: 47 × 5
## term estimate std.error statistic p.value
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 (Intercept) 4.48 0.410 10.9 5.54e-25
## 2 shared_values[TRUE] 0.0703 0.144 0.489 6.25e- 1
## 3 part_values[public health] -0.170 0.161 -1.05 2.93e- 1
## 4 sci_values[public health] 0.620 0.142 4.36 1.56e- 5
## 5 age -0.00175 0.00389 -0.451 6.52e- 1
## 6 gender[Man/Male.Man/Male] 0.207 0.116 1.78 7.51e- 2
## 7 gender[Man/Male.Woman/Female] 1.09 0.925 1.17 2.41e- 1
## 8 gender[Genderqueer/Gender non-binary/G… -1.29 0.917 -1.40 1.61e- 1
## 9 gender[Genderqueer/Gender non-binary/G… -0.691 0.949 -0.728 4.67e- 1
## 10 gender[Woman/Female.Man/Male] 0.498 0.767 0.650 5.16e- 1
## # … with 37 more rowsAnd actually participant values is independent of shared values: from a participant’s perspective (given their values), they have an equal chance of seeing a scientist with same or different values.
dataf |>
filter(disclosure) |>
count(part_values, sci_values, shared_values)## # A tibble: 6 × 4
## part_values sci_values shared_values n
## <chr> <chr> <lgl> <int>
## 1 economic growth economic growth TRUE 66
## 2 economic growth public health FALSE 55
## 3 public health economic growth FALSE 225
## 4 public health public health TRUE 221
## 5 <NA> economic growth NA 39
## 6 <NA> public health NA 54So dropping participant values from the regression doesn’t change the estimated effect of shared values.
model_d2 = dataf |>
filter(disclosure) %>%
lm(meti_mean ~ shared_values + sci_values, data = .)
summary(model_d2)##
## Call:
## lm(formula = meti_mean ~ shared_values + sci_values, data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.8799 -0.8799 -0.0529 0.9851 2.4215
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.57851 0.08111 56.447 < 2e-16 ***
## shared_values[TRUE] 0.11272 0.13190 0.855 0.393
## sci_values[public health] 0.61720 0.13194 4.678 3.63e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.286 on 564 degrees of freedom
## (93 observations deleted due to missingness)
## Multiple R-squared: 0.06708, Adjusted R-squared: 0.06377
## F-statistic: 20.28 on 2 and 564 DF, p-value: 3.139e-09But scientist values does confound the estimate.
model_d3 = dataf |>
filter(disclosure) %>%
lm(meti_mean ~ shared_values, data = .)
summary(model_d3)##
## Call:
## lm(formula = meti_mean ~ shared_values, data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.7379 -0.9522 -0.0236 0.9954 2.3003
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.69974 0.07827 60.047 < 2e-16 ***
## shared_values[TRUE] 0.46676 0.11001 4.243 2.58e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.31 on 565 degrees of freedom
## (93 observations deleted due to missingness)
## Multiple R-squared: 0.03088, Adjusted R-squared: 0.02916
## F-statistic: 18 on 1 and 565 DF, p-value: 2.579e-05Scientist values
We didn’t specify this possibility in advance, but all this suggests scientist values, not shared values, have an effect. This is randomly assigned, so no adjustments needed.
plot_adjustments(dag, 'sci_values') +
scale_color_manual(values = 'black')
model_emad_s = emad_df |>
filter(disclosure) %>%
lm(pa_mean ~ sci_values, data = .)
model_s = dataf |>
filter(disclosure) %>%
lm(meti_mean ~ sci_values, data = .)
summary(model_s)##
## Call:
## lm(formula = meti_mean ~ sci_values, data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.8398 -0.8565 -0.0496 1.0185 2.3790
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.62100 0.07089 65.185 < 2e-16 ***
## sci_values[public health] 0.64740 0.10025 6.458 2.07e-10 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.288 on 658 degrees of freedom
## Multiple R-squared: 0.0596, Adjusted R-squared: 0.05817
## F-statistic: 41.7 on 1 and 658 DF, p-value: 2.067e-10plot_estimate(list('emad' = model_emad_s,
'hl' = model_s),
str_detect(term, 'sci_values'))
dataf |>
filter(disclosure, !is.na(part_values)) |>
ggplot(aes(sci_values, meti_mean)) +
# geom_violin(draw_quantiles = .5) +
geom_beeswarm(dodge.width = 1, alpha = .25) +
geom_ribbon(data = plot_predictions(model_s,
focal_vars = 'sci_values',
return_plot = FALSE),
aes(y = .fitted, ymin = .lower, ymax = .upper),
alpha = .25, group = 1L, fill = 'blue') +
geom_line(data = plot_predictions(model_s,
focal_vars = 'sci_values',
return_plot = FALSE),
aes(y = .fitted, ymin = .lower, ymax = .upper),
alpha = 1, group = 1L, fill = 'blue')## Warning: Ignoring unknown parameters: fill## Warning: Ignoring unknown aesthetics: ymin, ymax
## One big regression table
shared_values_tbl = list(univariate = tbl_regression(model_d3,
intercept = TRUE,
label = c(shared_values ~ 'shared values')),
sci_values = tbl_regression(model_d2,
intercept = TRUE,
label = c(shared_values ~ 'shared values',
sci_values ~ 'scientist values')),
part_values = tbl_regression(model_d,
intercept = TRUE,
label = c(shared_values ~ 'shared values',
sci_values ~ 'scientist values',
part_values ~ 'participant values')),
demo = tbl_regression(model_d1,
intercept = TRUE,
label = c(shared_values ~ 'shared values',
sci_values ~ 'scientist values',
part_values ~ 'participant values',
religious_serv ~ 'rel. serv. attendance',
political_ideology ~ 'political id.'),
include = -c(gender, race_ethnicity,
religious_affil)),
sci_values_alone = tbl_regression(model_s,
intercept = TRUE,
label = c(sci_values ~ 'scientist values'))) |>
map(add_glance_table, include = c(r.squared, nobs, adj.r.squared,
statistic, p.value)) |>
tbl_merge(tab_spanner = c('(1) univariate',
'(2) scientist values',
'(3) participant values',
'(4) demographics',
'(5) scientist values alone')) |>
modify_table_body(~ arrange(.x, row_type == "glance_statistic"))
shared_values_tbl| Characteristic | (1) univariate | (2) scientist values | (3) participant values | (4) demographics | (5) scientist values alone | ||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | |
| (Intercept) | 4.7 | 4.5, 4.9 | <0.001 | 4.6 | 4.4, 4.7 | <0.001 | 4.7 | 4.5, 5.0 | <0.001 | 4.5 | 3.7, 5.3 | <0.001 | 4.6 | 4.5, 4.8 | <0.001 |
| shared values | |||||||||||||||
| shared_values[TRUE] | 0.47 | 0.25, 0.68 | <0.001 | 0.11 | -0.15, 0.37 | 0.4 | 0.10 | -0.16, 0.36 | 0.5 | 0.07 | -0.21, 0.35 | 0.6 | |||
| scientist values | |||||||||||||||
| sci_values[public health] | 0.62 | 0.36, 0.88 | <0.001 | 0.63 | 0.37, 0.89 | <0.001 | 0.62 | 0.34, 0.90 | <0.001 | 0.65 | 0.45, 0.84 | <0.001 | |||
| participant values | |||||||||||||||
| part_values[public health] | -0.18 | -0.44, 0.08 | 0.2 | -0.17 | -0.49, 0.15 | 0.3 | |||||||||
| age | 0.00 | -0.01, 0.01 | 0.7 | ||||||||||||
| rel. serv. attendance | 0.01 | -0.08, 0.10 | 0.9 | ||||||||||||
| political id. | -0.01 | -0.09, 0.06 | 0.8 | ||||||||||||
| education | 0.05 | -0.18, 0.28 | 0.6 | ||||||||||||
| R² | 0.031 | 0.067 | 0.070 | 0.143 | 0.060 | ||||||||||
| No. Obs. | 567 | 567 | 567 | 538 | 660 | ||||||||||
| Adjusted R² | 0.029 | 0.064 | 0.065 | 0.065 | 0.058 | ||||||||||
| Statistic | 18.0 | 20.3 | 14.1 | 1.83 | 41.7 | ||||||||||
| p-value | <0.001 | <0.001 | <0.001 | 0.001 | <0.001 | ||||||||||
| 1 CI = Confidence Interval | |||||||||||||||
write_reg_tbl(shared_values_tbl, here(out_dir, '03_shared_values_tbl'))
## E. Variation in effects ----E. Variation in effects
The magnitude of the effects above vary depending on whether the participant prioritizes public health or economic growth.
B: Consumer risk sensitivity
For B and C, bringing in participant values introduces a potential
back-door path through demographics. This is very similar to D.
Fortunately, as also with D, we just need to control
part_values (and conclusion).
dag |>
add_arrows(c('part_values -> conclusion_x_part_values <- conclusion',
'conclusion_x_part_values -> METI <- conclusion')) |>
plot_adjustments('conclusion_x_part_values')
model_eb_emad = lm(pa_mean ~ conclusion*part_values, data = emad_df)
summary(model_eb_emad)##
## Call:
## lm(formula = pa_mean ~ conclusion * part_values, data = emad_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.7437 -0.8610 0.1599 1.0251 2.5965
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 5.4116 0.1417
## conclusion[does not cause harm] -0.5505 0.2026
## part_values[public health] 0.3321 0.1819
## conclusion[does not cause harm]:part_values[public health] -0.7897 0.2557
## t value Pr(>|t|)
## (Intercept) 38.189 < 2e-16 ***
## conclusion[does not cause harm] -2.717 0.00682 **
## part_values[public health] 1.826 0.06853 .
## conclusion[does not cause harm]:part_values[public health] -3.089 0.00213 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.374 on 492 degrees of freedom
## (2 observations deleted due to missingness)
## Multiple R-squared: 0.1429, Adjusted R-squared: 0.1377
## F-statistic: 27.35 on 3 and 492 DF, p-value: 2.243e-16model_eb = lm(meti_mean ~ conclusion*part_values, data = dataf)
summary(model_eb)##
## Call:
## lm(formula = meti_mean ~ conclusion * part_values, data = dataf)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.9199 -0.7056 0.0087 0.8658 2.6042
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 5.3876 0.1131
## conclusion[does not cause harm] -0.7541 0.1673
## part_values[public health] 0.1752 0.1312
## conclusion[does not cause harm]:part_values[public health] -0.4128 0.1912
## t value Pr(>|t|)
## (Intercept) 47.632 < 2e-16 ***
## conclusion[does not cause harm] -4.509 7.45e-06 ***
## part_values[public health] 1.335 0.1823
## conclusion[does not cause harm]:part_values[public health] -2.159 0.0311 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.175 on 840 degrees of freedom
## (144 observations deleted due to missingness)
## Multiple R-squared: 0.1763, Adjusted R-squared: 0.1734
## F-statistic: 59.95 on 3 and 840 DF, p-value: < 2.2e-16plot_residuals(model_eb)## `geom_smooth()` using formula 'y ~ x'
# plot_estimate(model_eb, ':')
# plot_estimate(list(emad = model_eb_emad,
# hl = model_eb),
# str_detect(term, ':'))
plot_predictions(model_eb, c('conclusion', 'part_values'),
interaction_ci = TRUE)
plot_estimate(list(base = model_b, interaction = model_eb),
str_detect(term, 'conclusion'))
list(base = model_b, interaction = model_eb) |>
reg_tbl(labs = c('base', 'interaction'))| Characteristic | base | interaction | ||||
|---|---|---|---|---|---|---|
| Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | |
| (Intercept) | 5.5 | 5.4, 5.6 | <0.001 | 5.4 | 5.2, 5.6 | <0.001 |
| conclusion | ||||||
| conclusion[does not cause harm] | -1.0 | -1.1, -0.84 | <0.001 | -0.75 | -1.1, -0.43 | <0.001 |
| part_values | ||||||
| part_values[public health] | 0.18 | -0.08, 0.43 | 0.2 | |||
| conclusion * part_values | ||||||
| conclusion[does not cause harm] * part_values[public health] | -0.41 | -0.79, -0.04 | 0.031 | |||
| R² | 0.148 | 0.176 | ||||
| No. Obs. | 988 | 844 | ||||
| Adjusted R² | 0.147 | 0.173 | ||||
| Statistic | 171 | 59.9 | ||||
| p-value | <0.001 | <0.001 | ||||
| 1 CI = Confidence Interval | ||||||
Again, include demographics as a check
model_eb1 = lm(meti_mean ~ conclusion*part_values +
age + gender + race_ethnicity + religious_affil +
religious_serv + political_ideology + education,
data = dataf)
summary(model_eb1)##
## Call:
## lm(formula = meti_mean ~ conclusion * part_values + age + gender +
## race_ethnicity + religious_affil + religious_serv + political_ideology +
## education, data = dataf)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.703 -0.689 0.000 0.815 2.839
##
## Coefficients: (1 not defined because of singularities)
## Estimate
## (Intercept) 5.269896
## conclusion[does not cause harm] -0.725321
## part_values[public health] 0.199800
## age 0.002336
## gender[Man/Male.Man/Male] 0.061406
## gender[Man/Male.Woman/Female] 0.668535
## gender[Genderqueer/Gender non-binary/Gender fluid.Genderqueer/Gender non-binary/Gender fluid] -1.420756
## gender[Genderqueer/Gender non-binary/Gender fluid.Man/Male] -1.319357
## gender[Woman/Female.Man/Male] -0.811087
## gender[Man/Male & Genderqueer/Gender non-binary/Gender fluid.Man/Male] -1.813567
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female] -0.510207
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female & Genderqueer/Gender non-binary/Gender fluid] 1.197609
## gender[Different Identity.Genderqueer/Gender non-binary/Gender fluid] 1.392368
## gender[Genderqueer/Gender non-binary/Gender fluid.Indigenous or other cultural gender minority identity] 0.803310
## gender[Man/Male.Indigenous or other cultural gender minority identity] -1.415886
## gender[Woman/Female.Woman/Female & Man/Male] 1.022698
## race_ethnicity[3] 0.169188
## race_ethnicity[2] 0.008730
## race_ethnicity[4] 0.296248
## race_ethnicity[2,5] -0.344107
## race_ethnicity[4,5] 0.235121
## race_ethnicity[1,5] -0.186294
## race_ethnicity[3,5] 0.620084
## race_ethnicity[1] 0.247225
## race_ethnicity[6] 0.134925
## race_ethnicity[3,4] 0.542722
## race_ethnicity[1,3] 0.652296
## race_ethnicity[1,3,5] 1.425109
## race_ethnicity[1,4,5] -0.506392
## race_ethnicity[2,4,5] 0.910759
## race_ethnicity[5,6] NA
## race_ethnicity[6,7] -1.774866
## religious_affil[6] 0.266205
## religious_affil[2] 0.145139
## religious_affil[8] 0.491350
## religious_affil[9] 0.024232
## religious_affil[4] 0.647875
## religious_affil[1] 0.366487
## religious_affil[5] 0.671171
## religious_affil[3] 0.081191
## religious_affil[7,8] 0.570199
## religious_affil[1,2] 0.535704
## religious_affil[1,6] -0.854535
## religious_affil[1,7] 0.481840
## religious_affil[2,7] 0.009369
## religious_affil[4,7] 0.682151
## religious_affil[6,9] 1.667394
## religious_affil[8,9] 1.191154
## religious_serv -0.014953
## political_ideology -0.022497
## education -0.043906
## conclusion[does not cause harm]:part_values[public health] -0.463876
## Std. Error
## (Intercept) 0.297492
## conclusion[does not cause harm] 0.176724
## part_values[public health] 0.148537
## age 0.002882
## gender[Man/Male.Man/Male] 0.087234
## gender[Man/Male.Woman/Female] 0.834456
## gender[Genderqueer/Gender non-binary/Gender fluid.Genderqueer/Gender non-binary/Gender fluid] 0.682826
## gender[Genderqueer/Gender non-binary/Gender fluid.Man/Male] 0.623232
## gender[Woman/Female.Man/Male] 0.593137
## gender[Man/Male & Genderqueer/Gender non-binary/Gender fluid.Man/Male] 1.169456
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female] 0.876076
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female & Genderqueer/Gender non-binary/Gender fluid] 1.183602
## gender[Different Identity.Genderqueer/Gender non-binary/Gender fluid] 1.168886
## gender[Genderqueer/Gender non-binary/Gender fluid.Indigenous or other cultural gender minority identity] 1.170160
## gender[Man/Male.Indigenous or other cultural gender minority identity] 1.229431
## gender[Woman/Female.Woman/Female & Man/Male] 1.181591
## race_ethnicity[3] 0.133069
## race_ethnicity[2] 0.192705
## race_ethnicity[4] 0.245233
## race_ethnicity[2,5] 0.399441
## race_ethnicity[4,5] 0.481519
## race_ethnicity[1,5] 0.559966
## race_ethnicity[3,5] 0.485083
## race_ethnicity[1] 0.589822
## race_ethnicity[6] 0.606086
## race_ethnicity[3,4] 0.711323
## race_ethnicity[1,3] 1.187150
## race_ethnicity[1,3,5] 1.171498
## race_ethnicity[1,4,5] 1.170419
## race_ethnicity[2,4,5] 1.175382
## race_ethnicity[5,6] NA
## race_ethnicity[6,7] 1.291521
## religious_affil[6] 0.130309
## religious_affil[2] 0.156570
## religious_affil[8] 0.167107
## religious_affil[9] 0.233107
## religious_affil[4] 0.289311
## religious_affil[1] 0.368428
## religious_affil[5] 0.499712
## religious_affil[3] 0.514410
## religious_affil[7,8] 0.830187
## religious_affil[1,2] 1.191750
## religious_affil[1,6] 1.168884
## religious_affil[1,7] 1.185778
## religious_affil[2,7] 1.173376
## religious_affil[4,7] 1.168637
## religious_affil[6,9] 1.169145
## religious_affil[8,9] 1.664191
## religious_serv 0.035004
## political_ideology 0.028822
## education 0.086157
## conclusion[does not cause harm]:part_values[public health] 0.202327
## t value
## (Intercept) 17.714
## conclusion[does not cause harm] -4.104
## part_values[public health] 1.345
## age 0.811
## gender[Man/Male.Man/Male] 0.704
## gender[Man/Male.Woman/Female] 0.801
## gender[Genderqueer/Gender non-binary/Gender fluid.Genderqueer/Gender non-binary/Gender fluid] -2.081
## gender[Genderqueer/Gender non-binary/Gender fluid.Man/Male] -2.117
## gender[Woman/Female.Man/Male] -1.367
## gender[Man/Male & Genderqueer/Gender non-binary/Gender fluid.Man/Male] -1.551
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female] -0.582
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female & Genderqueer/Gender non-binary/Gender fluid] 1.012
## gender[Different Identity.Genderqueer/Gender non-binary/Gender fluid] 1.191
## gender[Genderqueer/Gender non-binary/Gender fluid.Indigenous or other cultural gender minority identity] 0.686
## gender[Man/Male.Indigenous or other cultural gender minority identity] -1.152
## gender[Woman/Female.Woman/Female & Man/Male] 0.866
## race_ethnicity[3] 1.271
## race_ethnicity[2] 0.045
## race_ethnicity[4] 1.208
## race_ethnicity[2,5] -0.861
## race_ethnicity[4,5] 0.488
## race_ethnicity[1,5] -0.333
## race_ethnicity[3,5] 1.278
## race_ethnicity[1] 0.419
## race_ethnicity[6] 0.223
## race_ethnicity[3,4] 0.763
## race_ethnicity[1,3] 0.549
## race_ethnicity[1,3,5] 1.216
## race_ethnicity[1,4,5] -0.433
## race_ethnicity[2,4,5] 0.775
## race_ethnicity[5,6] NA
## race_ethnicity[6,7] -1.374
## religious_affil[6] 2.043
## religious_affil[2] 0.927
## religious_affil[8] 2.940
## religious_affil[9] 0.104
## religious_affil[4] 2.239
## religious_affil[1] 0.995
## religious_affil[5] 1.343
## religious_affil[3] 0.158
## religious_affil[7,8] 0.687
## religious_affil[1,2] 0.450
## religious_affil[1,6] -0.731
## religious_affil[1,7] 0.406
## religious_affil[2,7] 0.008
## religious_affil[4,7] 0.584
## religious_affil[6,9] 1.426
## religious_affil[8,9] 0.716
## religious_serv -0.427
## political_ideology -0.781
## education -0.510
## conclusion[does not cause harm]:part_values[public health] -2.293
## Pr(>|t|)
## (Intercept) < 2e-16
## conclusion[does not cause harm] 4.5e-05
## part_values[public health] 0.17899
## age 0.41789
## gender[Man/Male.Man/Male] 0.48170
## gender[Man/Male.Woman/Female] 0.42329
## gender[Genderqueer/Gender non-binary/Gender fluid.Genderqueer/Gender non-binary/Gender fluid] 0.03780
## gender[Genderqueer/Gender non-binary/Gender fluid.Man/Male] 0.03459
## gender[Woman/Female.Man/Male] 0.17189
## gender[Man/Male & Genderqueer/Gender non-binary/Gender fluid.Man/Male] 0.12138
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female] 0.56049
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female & Genderqueer/Gender non-binary/Gender fluid] 0.31194
## gender[Different Identity.Genderqueer/Gender non-binary/Gender fluid] 0.23396
## gender[Genderqueer/Gender non-binary/Gender fluid.Indigenous or other cultural gender minority identity] 0.49261
## gender[Man/Male.Indigenous or other cultural gender minority identity] 0.24983
## gender[Woman/Female.Woman/Female & Man/Male] 0.38703
## race_ethnicity[3] 0.20397
## race_ethnicity[2] 0.96388
## race_ethnicity[4] 0.22742
## race_ethnicity[2,5] 0.38925
## race_ethnicity[4,5] 0.62549
## race_ethnicity[1,5] 0.73946
## race_ethnicity[3,5] 0.20154
## race_ethnicity[1] 0.67523
## race_ethnicity[6] 0.82389
## race_ethnicity[3,4] 0.44572
## race_ethnicity[1,3] 0.58285
## race_ethnicity[1,3,5] 0.22418
## race_ethnicity[1,4,5] 0.66539
## race_ethnicity[2,4,5] 0.43867
## race_ethnicity[5,6] NA
## race_ethnicity[6,7] 0.16978
## religious_affil[6] 0.04141
## religious_affil[2] 0.35423
## religious_affil[8] 0.00338
## religious_affil[9] 0.91724
## religious_affil[4] 0.02542
## religious_affil[1] 0.32019
## religious_affil[5] 0.17964
## religious_affil[3] 0.87463
## religious_affil[7,8] 0.49240
## religious_affil[1,2] 0.65319
## religious_affil[1,6] 0.46497
## religious_affil[1,7] 0.68460
## religious_affil[2,7] 0.99363
## religious_affil[4,7] 0.55959
## religious_affil[6,9] 0.15424
## religious_affil[8,9] 0.47436
## religious_serv 0.66937
## political_ideology 0.43532
## education 0.61048
## conclusion[does not cause harm]:part_values[public health] 0.02214
##
## (Intercept) ***
## conclusion[does not cause harm] ***
## part_values[public health]
## age
## gender[Man/Male.Man/Male]
## gender[Man/Male.Woman/Female]
## gender[Genderqueer/Gender non-binary/Gender fluid.Genderqueer/Gender non-binary/Gender fluid] *
## gender[Genderqueer/Gender non-binary/Gender fluid.Man/Male] *
## gender[Woman/Female.Man/Male]
## gender[Man/Male & Genderqueer/Gender non-binary/Gender fluid.Man/Male]
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female]
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female & Genderqueer/Gender non-binary/Gender fluid]
## gender[Different Identity.Genderqueer/Gender non-binary/Gender fluid]
## gender[Genderqueer/Gender non-binary/Gender fluid.Indigenous or other cultural gender minority identity]
## gender[Man/Male.Indigenous or other cultural gender minority identity]
## gender[Woman/Female.Woman/Female & Man/Male]
## race_ethnicity[3]
## race_ethnicity[2]
## race_ethnicity[4]
## race_ethnicity[2,5]
## race_ethnicity[4,5]
## race_ethnicity[1,5]
## race_ethnicity[3,5]
## race_ethnicity[1]
## race_ethnicity[6]
## race_ethnicity[3,4]
## race_ethnicity[1,3]
## race_ethnicity[1,3,5]
## race_ethnicity[1,4,5]
## race_ethnicity[2,4,5]
## race_ethnicity[5,6]
## race_ethnicity[6,7]
## religious_affil[6] *
## religious_affil[2]
## religious_affil[8] **
## religious_affil[9]
## religious_affil[4] *
## religious_affil[1]
## religious_affil[5]
## religious_affil[3]
## religious_affil[7,8]
## religious_affil[1,2]
## religious_affil[1,6]
## religious_affil[1,7]
## religious_affil[2,7]
## religious_affil[4,7]
## religious_affil[6,9]
## religious_affil[8,9]
## religious_serv
## political_ideology
## education
## conclusion[does not cause harm]:part_values[public health] *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.164 on 750 degrees of freedom
## (187 observations deleted due to missingness)
## Multiple R-squared: 0.2364, Adjusted R-squared: 0.1855
## F-statistic: 4.645 on 50 and 750 DF, p-value: < 2.2e-16eb_tbl = list(base = model_b, interaction = model_eb, demo = model_eb1) |>
reg_tbl(labs = c('base', 'interaction', 'demographics'))
eb_tbl| Characteristic | base | interaction | demographics | ||||||
|---|---|---|---|---|---|---|---|---|---|
| Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | |
| (Intercept) | 5.5 | 5.4, 5.6 | <0.001 | 5.4 | 5.2, 5.6 | <0.001 | 5.3 | 4.7, 5.9 | <0.001 |
| conclusion | |||||||||
| conclusion[does not cause harm] | -1.0 | -1.1, -0.84 | <0.001 | -0.75 | -1.1, -0.43 | <0.001 | -0.73 | -1.1, -0.38 | <0.001 |
| part_values | |||||||||
| part_values[public health] | 0.18 | -0.08, 0.43 | 0.2 | 0.20 | -0.09, 0.49 | 0.2 | |||
| conclusion * part_values | |||||||||
| conclusion[does not cause harm] * part_values[public health] | -0.41 | -0.79, -0.04 | 0.031 | -0.46 | -0.86, -0.07 | 0.022 | |||
| age | 0.00 | 0.00, 0.01 | 0.4 | ||||||
| religious_serv | -0.01 | -0.08, 0.05 | 0.7 | ||||||
| political_ideology | -0.02 | -0.08, 0.03 | 0.4 | ||||||
| education | -0.04 | -0.21, 0.13 | 0.6 | ||||||
| R² | 0.148 | 0.176 | 0.236 | ||||||
| No. Obs. | 988 | 844 | 801 | ||||||
| Adjusted R² | 0.147 | 0.173 | 0.186 | ||||||
| Statistic | 171 | 59.9 | 4.64 | ||||||
| p-value | <0.001 | <0.001 | <0.001 | ||||||
| 1 CI = Confidence Interval | |||||||||
write_reg_tbl(eb_tbl, here(out_dir, '03_eb_tbl'))
emad_df |>
filter(!is.na(part_values), disclosure) |>
ggplot(aes(conclusion, pa_mean)) +
geom_boxplot() +
facet_wrap(vars(part_values))
dataf |>
filter(!is.na(part_values), disclosure) |>
ggplot(aes(conclusion, meti_mean)) +
geom_beeswarm(alpha = .5, cex = 1.5, size = .5) +
stat_summary(fun.data = mean_cl_boot, color = 'red',
size = 1, fatten = 0) +
stat_summary(fun.data = mean_cl_boot, geom = 'line', group = 1L, color = 'red') +
facet_wrap(vars(part_values)) +
labs(x = 'scientist conclusion: BPA ...',
y = 'perceived trustworthiness')
ggsave(here(out_dir, '03_conclusion_part.png'),
height = 3, width = 6, scale = 1,
bg = 'white')C: Disclosure
dag |>
add_arrows(c('part_values -> disclosure_x_part_values <- disclosure',
'disclosure_x_part_values -> METI',
'disclosure -> METI')) |>
plot_adjustments('disclosure_x_part_values')
model_ec_emad = lm(pa_mean ~ disclosure*part_values, data = emad_df)
summary(model_ec_emad)##
## Call:
## lm(formula = pa_mean ~ disclosure * part_values, data = emad_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.4090 -1.0042 0.1387 1.1446 2.1387
##
## Coefficients:
## Estimate Std. Error t value
## (Intercept) 5.35272 0.18476 28.971
## disclosure[TRUE] -0.32001 0.22784 -1.405
## part_values[public health] 0.05629 0.23878 0.236
## disclosure[TRUE]:part_values[public health] -0.22770 0.29095 -0.783
## Pr(>|t|)
## (Intercept) <2e-16 ***
## disclosure[TRUE] 0.161
## part_values[public health] 0.814
## disclosure[TRUE]:part_values[public health] 0.434
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.466 on 492 degrees of freedom
## (2 observations deleted due to missingness)
## Multiple R-squared: 0.02353, Adjusted R-squared: 0.01758
## F-statistic: 3.953 on 3 and 492 DF, p-value: 0.008371lm(pa_mean ~ disclosure*part_values+
sex + ideology + educatio + age, data = emad_df) |>
summary()##
## Call:
## lm(formula = pa_mean ~ disclosure * part_values + sex + ideology +
## educatio + age, data = emad_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.2393 -0.9427 0.1744 1.1730 2.2864
##
## Coefficients:
## Estimate Std. Error t value
## (Intercept) 5.227099 0.334903 15.608
## disclosure[TRUE] -0.323021 0.228681 -1.413
## part_values[public health] 0.003625 0.243423 0.015
## sex 0.025026 0.134675 0.186
## ideology 0.007676 0.042153 0.182
## educatio -0.084100 0.064652 -1.301
## age 0.069062 0.031725 2.177
## disclosure[TRUE]:part_values[public health] -0.256452 0.291972 -0.878
## Pr(>|t|)
## (Intercept) <2e-16 ***
## disclosure[TRUE] 0.158
## part_values[public health] 0.988
## sex 0.853
## ideology 0.856
## educatio 0.194
## age 0.030 *
## disclosure[TRUE]:part_values[public health] 0.380
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.459 on 484 degrees of freedom
## (6 observations deleted due to missingness)
## Multiple R-squared: 0.03626, Adjusted R-squared: 0.02232
## F-statistic: 2.601 on 7 and 484 DF, p-value: 0.01212model_ec = lm(meti_mean ~ disclosure*part_values, data = dataf)
summary(model_ec)##
## Call:
## lm(formula = meti_mean ~ disclosure * part_values, data = dataf)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.9023 -0.9061 0.0977 1.0263 2.0977
##
## Coefficients:
## Estimate Std. Error t value
## (Intercept) 5.01557 0.14634 34.273
## disclosure[TRUE] 0.04464 0.18767 0.238
## part_values[public health] 0.07453 0.17265 0.432
## disclosure[TRUE]:part_values[public health] -0.23243 0.21762 -1.068
## Pr(>|t|)
## (Intercept) <2e-16 ***
## disclosure[TRUE] 0.812
## part_values[public health] 0.666
## disclosure[TRUE]:part_values[public health] 0.286
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.292 on 840 degrees of freedom
## (144 observations deleted due to missingness)
## Multiple R-squared: 0.004245, Adjusted R-squared: 0.0006885
## F-statistic: 1.194 on 3 and 840 DF, p-value: 0.3111plot_residuals(model_ec)## `geom_smooth()` using formula 'y ~ x'
# plot_estimate(model_ec, ':')
plot_estimate(list(base = model_c, interaction = model_ec),
str_detect(term, 'disclosure'))
plot_predictions(model_ec, c('disclosure', 'part_values'),
interaction_ci = TRUE)
model_ec1 = lm(meti_mean ~ disclosure * part_values +
age + gender + race_ethnicity + religious_affil +
religious_serv + political_ideology + education,
data = dataf)
ec_tbl = list(base = model_c, interaction = model_ec, demographics = model_ec1) |>
reg_tbl(labs = c('base', 'interaction', 'demographics'))
ec_tbl| Characteristic | base | interaction | demographics | ||||||
|---|---|---|---|---|---|---|---|---|---|
| Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | |
| (Intercept) | 5.1 | 4.9, 5.2 | <0.001 | 5.0 | 4.7, 5.3 | <0.001 | 4.9 | 4.3, 5.6 | <0.001 |
| disclosure | |||||||||
| disclosure[TRUE] | -0.11 | -0.28, 0.06 | 0.2 | 0.04 | -0.32, 0.41 | 0.8 | 0.05 | -0.34, 0.43 | 0.8 |
| part_values | |||||||||
| part_values[public health] | 0.07 | -0.26, 0.41 | 0.7 | 0.14 | -0.23, 0.51 | 0.5 | |||
| disclosure * part_values | |||||||||
| disclosure[TRUE] * part_values[public health] | -0.23 | -0.66, 0.19 | 0.3 | -0.29 | -0.74, 0.15 | 0.2 | |||
| age | 0.00 | 0.00, 0.01 | 0.5 | ||||||
| religious_serv | 0.02 | -0.06, 0.09 | 0.7 | ||||||
| political_ideology | -0.02 | -0.08, 0.04 | 0.5 | ||||||
| education | -0.07 | -0.26, 0.11 | 0.4 | ||||||
| R² | 0.002 | 0.004 | 0.071 | ||||||
| No. Obs. | 988 | 844 | 801 | ||||||
| Adjusted R² | 0.001 | 0.001 | 0.009 | ||||||
| Statistic | 1.60 | 1.19 | 1.15 | ||||||
| p-value | 0.2 | 0.3 | 0.2 | ||||||
| 1 CI = Confidence Interval | |||||||||
write_reg_tbl(ec_tbl, here(out_dir, '03_ec_tbl'))
dataf |>
filter(!is.na(part_values)) |>
ggplot(aes(disclosure, meti_mean)) +
geom_boxplot() +
# geom_beeswarm(alpha = .25) +
facet_wrap(vars(part_values))
D: Shared values
dag |>
add_arrows(c('part_values -> shared_values_x_part_values <- shared_values',
'shared_values_x_part_values -> METI')) |>
plot_adjustments('shared_values_x_part_values')
model_ed_emad = emad_df |>
filter(disclosure) %>%
lm(pa_mean ~ shared_values*part_values, data = .)
summary(model_ed_emad)##
## Call:
## lm(formula = pa_mean ~ shared_values * part_values, data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.0914 -0.9710 0.0515 1.0508 2.4678
##
## Coefficients:
## Estimate Std. Error t value
## (Intercept) 5.0914 0.1861 27.353
## shared_values[TRUE] -0.1204 0.2666 -0.452
## part_values[public health] -0.5592 0.2306 -2.425
## shared_values[TRUE]:part_values[public health] 0.8237 0.3326 2.477
## Pr(>|t|)
## (Intercept) <2e-16 ***
## shared_values[TRUE] 0.6519
## part_values[public health] 0.0158 *
## shared_values[TRUE]:part_values[public health] 0.0138 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.466 on 335 degrees of freedom
## (1 observation deleted due to missingness)
## Multiple R-squared: 0.03948, Adjusted R-squared: 0.03088
## F-statistic: 4.59 on 3 and 335 DF, p-value: 0.003648emad_df |>
filter(disclosure) %>%
lm(pa_mean ~ shared_values*part_values+
sex + ideology + educatio + age, data = .) |>
summary()##
## Call:
## lm(formula = pa_mean ~ shared_values * part_values + sex + ideology +
## educatio + age, data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.1096 -0.9497 0.1137 1.0829 2.5987
##
## Coefficients:
## Estimate Std. Error t value
## (Intercept) 4.90369 0.37655 13.023
## shared_values[TRUE] -0.10460 0.26597 -0.393
## part_values[public health] -0.64016 0.23782 -2.692
## sex 0.01372 0.16314 0.084
## ideology 0.01906 0.05045 0.378
## educatio -0.11132 0.07683 -1.449
## age 0.08645 0.03721 2.323
## shared_values[TRUE]:part_values[public health] 0.78037 0.33276 2.345
## Pr(>|t|)
## (Intercept) < 2e-16 ***
## shared_values[TRUE] 0.69436
## part_values[public health] 0.00747 **
## sex 0.93305
## ideology 0.70589
## educatio 0.14831
## age 0.02079 *
## shared_values[TRUE]:part_values[public health] 0.01962 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.457 on 328 degrees of freedom
## (4 observations deleted due to missingness)
## Multiple R-squared: 0.0558, Adjusted R-squared: 0.03565
## F-statistic: 2.769 on 7 and 328 DF, p-value: 0.008261model_ed = dataf |>
filter(disclosure) %>%
lm(meti_mean ~ shared_values*part_values, data = .)
summary(model_ed)##
## Call:
## lm(formula = meti_mean ~ shared_values * part_values, data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.8416 -0.8981 -0.0559 0.9590 2.4590
##
## Coefficients:
## Estimate Std. Error t value
## (Intercept) 5.3494 0.1733 30.869
## shared_values[TRUE] -0.5301 0.2346 -2.259
## part_values[public health] -0.8084 0.1933 -4.182
## shared_values[TRUE]:part_values[public health] 1.2593 0.2643 4.764
## Pr(>|t|)
## (Intercept) < 2e-16 ***
## shared_values[TRUE] 0.0243 *
## part_values[public health] 3.35e-05 ***
## shared_values[TRUE]:part_values[public health] 2.41e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.285 on 563 degrees of freedom
## (93 observations deleted due to missingness)
## Multiple R-squared: 0.0701, Adjusted R-squared: 0.06514
## F-statistic: 14.15 on 3 and 563 DF, p-value: 6.696e-09## Including scientist values creates perfect collinearity
dataf |>
filter(disclosure) %>%
lm(meti_mean ~ shared_values*part_values + sci_values, data = .) |>
summary()##
## Call:
## lm(formula = meti_mean ~ shared_values * part_values + sci_values,
## data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.8416 -0.8981 -0.0559 0.9590 2.4590
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error t value
## (Intercept) 4.71968 0.13216 35.711
## shared_values[TRUE] 0.09958 0.13216 0.753
## part_values[public health] -0.17873 0.13216 -1.352
## sci_values[public health] 0.62967 0.13216 4.764
## shared_values[TRUE]:part_values[public health] NA NA NA
## Pr(>|t|)
## (Intercept) < 2e-16 ***
## shared_values[TRUE] 0.451
## part_values[public health] 0.177
## sci_values[public health] 2.41e-06 ***
## shared_values[TRUE]:part_values[public health] NA
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.285 on 563 degrees of freedom
## (93 observations deleted due to missingness)
## Multiple R-squared: 0.0701, Adjusted R-squared: 0.06514
## F-statistic: 14.15 on 3 and 563 DF, p-value: 6.696e-09plot_estimate(list(base = model_d,
interaction = model_ed),
str_detect(term, 'shared_values'))
model_ed1 = dataf |>
filter(disclosure) %>%
lm(meti_mean ~ shared_values*part_values+
age + gender + race_ethnicity + religious_affil +
religious_serv + political_ideology + education,
data = .)
list(model_d, model_ed, model_ed1) |>
reg_tbl(labs = c('base', 'interaction', 'demographics'))| Characteristic | base | interaction | demographics | ||||||
|---|---|---|---|---|---|---|---|---|---|
| Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | |
| (Intercept) | 4.7 | 4.5, 5.0 | <0.001 | 5.3 | 5.0, 5.7 | <0.001 | 5.1 | 4.3, 5.9 | <0.001 |
| shared_values | |||||||||
| shared_values[TRUE] | 0.10 | -0.16, 0.36 | 0.5 | -0.53 | -1.0, -0.07 | 0.024 | -0.55 | -1.1, -0.05 | 0.031 |
| part_values | |||||||||
| part_values[public health] | -0.18 | -0.44, 0.08 | 0.2 | -0.81 | -1.2, -0.43 | <0.001 | -0.79 | -1.2, -0.36 | <0.001 |
| sci_values | |||||||||
| sci_values[public health] | 0.63 | 0.37, 0.89 | <0.001 | ||||||
| shared_values * part_values | |||||||||
| shared_values[TRUE] * part_values[public health] | 1.3 | 0.74, 1.8 | <0.001 | 1.2 | 0.68, 1.8 | <0.001 | |||
| age | 0.00 | -0.01, 0.01 | 0.7 | ||||||
| religious_serv | 0.01 | -0.08, 0.10 | 0.9 | ||||||
| political_ideology | -0.01 | -0.09, 0.06 | 0.8 | ||||||
| education | 0.05 | -0.18, 0.28 | 0.6 | ||||||
| R² | 0.070 | 0.070 | 0.143 | ||||||
| No. Obs. | 567 | 567 | 538 | ||||||
| Adjusted R² | 0.065 | 0.065 | 0.065 | ||||||
| Statistic | 14.1 | 14.1 | 1.83 | ||||||
| p-value | <0.001 | <0.001 | 0.001 | ||||||
| 1 CI = Confidence Interval | |||||||||
Effect of shared values appears to go in opposite directions, depending on participant values
plot_predictions(model_ed,
c('part_values', 'shared_values'),
interaction_ci = TRUE)
dataf |>
filter(!is.na(part_values), disclosure) |>
ggplot(aes(shared_values, meti_mean)) +
# geom_boxplot() +
geom_beeswarm(alpha = .5, cex = 1.5, size = .5) +
facet_wrap(vars(part_values)) +
## model_ed is a confounded mess;
# geom_ribbon(data = plot_predictions(model_ed,
# c('part_values', 'shared_values'),
# return_plot = FALSE),
# aes(y = .fitted, ymin = .lower, ymax = .upper),
# group = 1L, alpha = .5, fill = 'blue') +
# geom_line(data = plot_predictions(model_ed,
# c('part_values', 'shared_values'),
# return_plot = FALSE),
# aes(y = .fitted, ymin = .lower, ymax = .upper),
# group = 1L, alpha = 1, color = 'blue') +
## just do mean + CI
stat_summary(fun.data = mean_cl_boot, color = 'red',
size = 1, fatten = 0) +
stat_summary(fun.data = mean_cl_boot, geom = 'line', group = 1L, color = 'red') +
labs(x = 'shared values',
y = 'perceived trustworthiness')
ggsave(here(out_dir, '03_shared_part.png'),
height = 3, width = 6, scale = 1,
bg = 'white')And political ideology appears to be either entirely upstream or independent to this
dataf |>
filter(disclosure) %>%
lm(meti_mean ~ shared_values*part_values + political_ideology, data = .) |>
summary()##
## Call:
## lm(formula = meti_mean ~ shared_values * part_values + political_ideology,
## data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.8353 -0.8809 -0.0615 0.9464 2.4839
##
## Coefficients:
## Estimate Std. Error t value
## (Intercept) 5.396724 0.240008 22.486
## shared_values[TRUE] -0.518383 0.240109 -2.159
## part_values[public health] -0.856955 0.206333 -4.153
## political_ideology -0.003948 0.033497 -0.118
## shared_values[TRUE]:part_values[public health] 1.262260 0.269799 4.679
## Pr(>|t|)
## (Intercept) < 2e-16 ***
## shared_values[TRUE] 0.0313 *
## part_values[public health] 3.81e-05 ***
## political_ideology 0.9062
## shared_values[TRUE]:part_values[public health] 3.66e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.274 on 536 degrees of freedom
## (119 observations deleted due to missingness)
## Multiple R-squared: 0.07522, Adjusted R-squared: 0.06832
## F-statistic: 10.9 on 4 and 536 DF, p-value: 1.675e-08Apparently independent
dataf |>
filter(disclosure) %>%
lm(meti_mean ~ political_ideology, data = .) |>
summary()##
## Call:
## lm(formula = meti_mean ~ political_ideology, data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.9494 -0.9437 0.0569 1.0506 2.0633
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.954527 0.105865 46.80 <2e-16 ***
## political_ideology -0.002545 0.028266 -0.09 0.928
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.322 on 628 degrees of freedom
## (30 observations deleted due to missingness)
## Multiple R-squared: 1.291e-05, Adjusted R-squared: -0.001579
## F-statistic: 0.008105 on 1 and 628 DF, p-value: 0.9283dataf |>
filter(disclosure) |>
ggplot(aes(political_ideology, meti_mean, group = political_ideology)) +
geom_violin(draw_quantiles = .5) +
geom_beeswarm()## Warning: Removed 30 rows containing non-finite values (stat_ydensity).## Warning: Removed 30 rows containing missing values (position_beeswarm).
Because the effect is with scientist values (we also saw this at the end of D)
model_es = dataf |>
filter(disclosure) %>%
lm(meti_mean ~ sci_values + part_values, data = .)
summary(model_es)##
## Call:
## lm(formula = meti_mean ~ sci_values + part_values, data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.8203 -0.8918 -0.0619 0.9659 2.4381
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.7479 0.1267 37.478 < 2e-16 ***
## sci_values[public health] 0.6870 0.1080 6.361 4.14e-10 ***
## part_values[public health] -0.1861 0.1318 -1.412 0.158
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.285 on 564 degrees of freedom
## (93 observations deleted due to missingness)
## Multiple R-squared: 0.06916, Adjusted R-squared: 0.06586
## F-statistic: 20.95 on 2 and 564 DF, p-value: 1.671e-09plot_predictions(model_es, 'sci_values')
dataf |>
filter(!is.na(part_values), disclosure) |>
ggplot(aes(sci_values, meti_mean)) +
# geom_boxplot() +
geom_beeswarm(alpha = .5, cex = 1.5, size = .5) +
facet_wrap(vars(part_values)) +
# geom_ribbon(data = plot_predictions(model_es,
# c('sci_values', 'part_values'),
# return_plot = FALSE),
# aes(y = .fitted, ymin = .lower, ymax = .upper),
# group = 1L, alpha = .5, fill = 'blue') +
# geom_line(data = plot_predictions(model_es,
# c('sci_values', 'part_values'),
# return_plot = FALSE),
# aes(y = .fitted, ymin = .lower, ymax = .upper),
# group = 1L, alpha = 1, color = 'blue') +
stat_summary(fun.data = mean_cl_boot, color = 'red',
size = 1, fatten = 0) +
stat_summary(fun.data = mean_cl_boot, geom = 'line', group = 1L, color = 'red') +
labs(x = 'scientist values',
y = 'perceived trustworthiness')
ggsave(here(out_dir, '03_sci_part.png'), height = 3, width = 6, scale = 1, bg = 'white')Any interaction with participant values is swamped by uncertainty Though Emilio thinks this might be worth reporting bc of difference in variation btwn participant values groups How are participants thinking of economic growth? Might be thinking of indirect effects, eg, good economy -> better hospitals and public health system
dataf %>%
filter(disclosure) %>%
lm(meti_mean ~ sci_values*part_values, data = .) |>
# summary()
plot_predictions(c('sci_values', 'part_values'),
interaction_ci = TRUE)
lm(meti_mean ~ sci_values * part_values,
data = filter(dataf, disclosure)) |>
summary()##
## Call:
## lm(formula = meti_mean ~ sci_values * part_values, data = filter(dataf,
## disclosure))
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.8416 -0.8981 -0.0559 0.9590 2.4590
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 4.8193 0.1582
## sci_values[public health] 0.5301 0.2346
## part_values[public health] -0.2783 0.1799
## sci_values[public health]:part_values[public health] 0.1992 0.2643
## t value Pr(>|t|)
## (Intercept) 30.464 <2e-16 ***
## sci_values[public health] 2.259 0.0243 *
## part_values[public health] -1.547 0.1224
## sci_values[public health]:part_values[public health] 0.753 0.4515
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.285 on 563 degrees of freedom
## (93 observations deleted due to missingness)
## Multiple R-squared: 0.0701, Adjusted R-squared: 0.06514
## F-statistic: 14.15 on 3 and 563 DF, p-value: 6.696e-09sci_part_tbl = list(base = model_s,
part_values = model_es,
interaction = lm(meti_mean ~ sci_values * part_values,
data = filter(dataf, disclosure)),
demographics = lm(meti_mean ~ sci_values * part_values +
age + gender + race_ethnicity + religious_affil +
religious_serv + political_ideology + education,
data = filter(dataf, disclosure))) |>
reg_tbl(labs = c('base', 'participant values', 'interaction', 'demographics'))
write_reg_tbl(sci_part_tbl, here(out_dir, '03_sci_part_tbl'))